home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / SEDITOR.SEQ < prev    next >
Text File  |  1988-06-30  |  63KB  |  1,605 lines
  1. \ SEDITOR.SEQ   Sequential EDitor          Written by 1987 Tom Zimmer
  2.  
  3. comment:
  4.  
  5. Hello -
  6.  
  7. SED the Sequential EDitor was written by Tom Zimmer.
  8.  
  9. SED is released into the Public Domain. It is included as an imbedded
  10. portion of the F-PC Forth system, and may be used as needed to develop
  11. programs on that system. SED is provided in source form in the F-PC system
  12. to allow you the ability to change SEDs characteristics. The Forth system
  13. F-PC is also in the public domain, and as such you may do with F-PC
  14. and SED as you wish.
  15.  
  16.                                         Tom Zimmer
  17.  
  18. comment;
  19.  
  20. only forth also hidden also
  21.  
  22. editor also definitions
  23.  
  24.               1 constant real.firstline
  25.  real.firstline constant first.textline
  26.              24 constant lines/screen
  27.               0 constant statusline
  28.               1 constant helpline
  29.             250 constant ch/l
  30.             187 constant helpkey        \ default value is F1 key
  31.  
  32. lines/screen 1- constant last.textline
  33.               0 constant torig          \ origin of text in text segment
  34.            2573 constant crlfval        \ value of line terminator CRLF.
  35.            8224 constant blbl           \ value of two blanks.
  36.             255 constant linebuf.len
  37.              12 constant formfeed
  38.              55 constant prtlines       \ print lines per page
  39.  
  40. variable imode          \ insert mode flag
  41. variable lmrgn
  42. variable etabsize       8 etabsize !    \ default to 8 char increment
  43. variable memleft
  44. variable newfl          \ was new file created?
  45. variable changed        \ edit changed flag
  46. variable markline       \ mark/get line #
  47. variable markchar       \ mark/get character offset
  48. variable updated        \ have we updated to disk yet?
  49. variable lookflg        \ did we find anything last time?
  50. \ variable xrmrgn
  51. variable wrapped
  52. variable wraplen
  53. variable wraploc
  54. variable escflg         \ are we escaping during filename entry
  55. variable filtering      \ are we looking for ESC and Alt-F10?
  56. variable lchng          \ line changed flag
  57. variable ldel.cnt       \ count of line deletes
  58. variable emptyline
  59. variable lastldline     \ last line we were editing.
  60.  
  61. create nfil  13 c, 10 c, 13 c, 10 c, 13 c, 10 c, \ empty file
  62. create blnks 128 allot blnks 128 blank
  63.  
  64. 0 constant screenline           \ current screen line
  65.  
  66. variable origcur
  67. : cursave       ( --- ) get-cursor origcur ! ;
  68. : currest       ( --- ) origcur @ set-cursor ;
  69.  
  70. defer showstat
  71. defer exit.edit         ' quit   is exit.edit   \ default to just quit
  72. defer doacharx
  73. defer normkey           ' bl     is normkey
  74. defer normfilter        ' noop   is normfilter
  75. defer normbgstuff       ' noop   is normbgstuff
  76. defer ins-cursor        ' big-cursor is ins-cursor
  77.  
  78. variable vstaton
  79. variable statcnt
  80.  
  81. create slook.buf   36 allot     \ search buffer
  82.        slook.buf   36 blank 1 slook.buf c!
  83.  
  84. create   linebuf linebuf.len allot   linebuf linebuf.len blank
  85. create  temp.buf linebuf.len allot  temp.buf linebuf.len blank
  86. create split.buf linebuf.len allot split.buf linebuf.len blank
  87. create  wrap.buf linebuf.len allot  wrap.buf linebuf.len blank
  88. create temp2.buf linebuf.len allot temp2.buf linebuf.len blank
  89. create fdbuf     36          allot fdbuf     36          erase
  90.  
  91. variable csaveflg       \ are we saving characters
  92.  
  93. 0 constant ldel.buf
  94. 0 constant linelen
  95.  
  96. create --'s.buf 80 allot        --'s.buf 80 hex c4 decimal fill
  97.  
  98. : -s    ( n1 --- )      --'s.buf swap video-type ;
  99.  
  100. : gremit create c, does> 1 video-type ;
  101.  
  102. hex
  103. c0 gremit |.    c4 gremit --  ( b3 gremit | )   d9 gremit .|
  104. bf gremit '|    da gremit |'
  105. decimal
  106.  
  107. : ss spaces ;
  108.  
  109. \ : ||            ( --- ) 79 #line @ at | ;
  110.  
  111. : .l            ( n1 n2 --- )   \ Print left justified in fld
  112.                 >r (u.) dup >r type r> r> swap - 0 max
  113.                 ?dup    if  blnks swap type then ;
  114.  
  115. : emptykbd      ( --- ) \ empty any keyboard typeahead
  116.                 begin   0 1050 @L
  117.                         0 1052 @L - abs 2 >     \ keyboard depth > 1 key
  118.                 while   bioskey drop
  119.                 repeat  ;
  120.  
  121. hex             \ 02 = Shift key, 08 = Alt key, 40 = Caps lock.
  122.  
  123. \ : ?capslock     ( --- f1 ) 0 417 c@l 40 and 0<> ;
  124. : ?ctrlkey      ( --- f1 ) 0 417 c@l 04 and 0<> ;
  125. : ?shiftkey     ( --- f1 ) 0 417 c@l 02 and 0<> ;
  126.  
  127. decimal
  128.  
  129. create  end-spcs 80 allot
  130.         end-spcs 80 177 fill
  131.  
  132. : eeol          ( --- )         \ clear the screen line.
  133.                 spcs 80 #out @ - video-type ;
  134.  
  135. : end-eeol      ( --- )         \ clear the screen line.
  136.                 end-spcs 80 #out @ - video-type ;
  137.  
  138. : creeol        ( --- )         \ erase next line.
  139.                 cr eeol 0 #line @ at ;
  140.  
  141. : erase.bottom  ( --- )
  142.                 0 #line @ 24 over - 1 max 0
  143.                 do creeol loop at ;
  144.  
  145. : terminate.edit        ( --- )
  146.                 shndl+ clr-hcb
  147.                 creeol creeol ." Leaving now...." creeol
  148.                 erase.bottom exit.edit ;
  149.  
  150. : ?terror       ( f1 a1 n1 --- )        \ handle errors
  151.                 rot
  152.                 if      creeol type terminate.edit
  153.                 else    2drop then    ;
  154.  
  155. : ?<>bak        ( --- )                 \ verify current file is not a .BAK
  156.                 shndl @ handle>ext 1+ " BAK" caps-comp 0=
  157.                 " Can't edit files with ext .BAK" ?terror ;
  158.  
  159. : set.newfile   ( --- )         \ setup memory for a new file
  160.                 creeol ."    New File Created "  creeol
  161.                 currentsize off
  162.                 temp2.buf 64 blank
  163.                 ?cs: temp2.buf  torig tb: 64 cmovel
  164.                 4 toff ! ?cs: nfil torig tb: 4 cmovel
  165.                 5 tenths ;
  166.  
  167. : ?softerror    ( bool a1 n1 --- )
  168.                 rot
  169.                 if      beep 0 statusline at >attrib4
  170.                         type eeol >norm cursor-off 2 seconds
  171.                         showstat
  172.                 else    2drop
  173.                 then    ;
  174.  
  175. : change.ext    ( a1 --- )      \ rename file in tfcb to have
  176.                 renaming @
  177.                 if      shndl @  shndl+ b/hcb cmove
  178.                         shndl+ $>ext
  179.                         shndl+ hdelete drop     \ delete old backup
  180.                         shndl @ shndl+ hrename
  181.                         dup 3 = over        5 = or swap    17 = or
  182.                         \   no path found,  access denied, no path found
  183.                         newfl @ 0= and " Rename error"  ?terror
  184.                 else    drop
  185.                 then    ;
  186.  
  187. : clearit       initstuff 0 dos-line c! ;
  188.  
  189. : read.openfile ( --- ) \ read a file that is already open.
  190.                 ?<>bak
  191.                 shndl @ endfile 2dup 128 um/mod nip 1+ currentsize !
  192.                 65000. dmin drop dup toff ! >r
  193.                 creeol ." Reading... "
  194.                 shndl @ >attrib1 count type >norm creeol
  195.                 0.0 shndl @ movepointer
  196.                 torig r> shndl @ tsegb @ exhread drop ;
  197.  
  198.  
  199. : read.oldfile ( --- )         \ get existing file
  200.                 newfl off
  201.                 shndl @ endfile 65000. D>
  202.                 " Sorry, File is TOO BIG, use another editor." ?terror
  203.                 read.openfile ;
  204.  
  205. : warn-prompt   ( --- )
  206.                 >revblnk ."  NO ROOM TO SAVE " >norm
  207.                 ."  changes made to this file !!"  beep 3 tenths
  208.                 creeol creeol tab
  209.                 ." You might try using Alt-W to write to another drive."
  210.                 creeol creeol
  211.                 tab tab ." PRESS A KEY to acknowledge "  beep
  212.                 emptykbd key? if key drop then key drop ;
  213.  
  214. : ?diskfull     ( --- f1 )
  215.                 renaming @ 0=
  216.                 if      false exit
  217.                 then
  218.                 shndl @ >nam 1+ c@ ascii : =
  219.                 if  shndl @ >nam c@ bl or 96 - else 0 then
  220.                 getdiskfree * 0 128 um/mod nip *D
  221.                 ( toff @  tend @ negate + ) 64000. 128 um/mod swap
  222.                 if      1+ then 0 D< dup
  223.                 if      creeol tab tab tab >revblnk ." WARNING !!" >norm
  224.                         creeol
  225.                         creeol ." You have LESS than 64000 bytes free on disk"
  226.                         beep 3 tenths
  227.                         creeol ." There may be " warn-prompt
  228.                 then    ;
  229.  
  230. : ?enoughdisk   ( --- f1 )      \ true if there is enough disk space to save
  231.                 shndl @ >nam 1+ c@ ascii : =
  232.                 if  shndl @ >nam c@ bl or 96 - else 0 then
  233.                 getdiskfree * 0 128 um/mod nip *D
  234.                 renaming @ 0=
  235.                 if      currentsize @ 0 d+
  236.                 then
  237.                 toff @  tend @ negate + 0 128 um/mod swap
  238.                 if      1+ then 0 D< dup
  239.                 if      dark cr cr
  240.                         creeol tab tab tab >revblnk ."  WARNING !! " >norm
  241.                         creeol beep 3 tenths
  242.                         creeol tab ." There is " warn-prompt
  243.                 then    0= ;
  244.  
  245. : read.file     ( --- )         \ read file in shndl
  246.                 ?<>bak
  247.                 -1 tend ! newfl off
  248.                 shndl @ hopen           \ opens the file.
  249.                 if      newfl on set.newfile
  250.                 else    read.oldfile
  251.                         5 tenths
  252.                         shndl @ hclose " Close Error" ?terror
  253.                         ?diskfull drop
  254.                 then    ;
  255.  
  256. : ?change.bak   ( --- )
  257.                 newfl @ 0=
  258.                 if      " BAK" ">$ change.ext then    ;
  259.  
  260. : write.file    ( --- )         \ write file in shndl
  261.                                   \ WRITE.FILE assumes we are on FIRST line.
  262.                 shndl @ hcreate dup " Error Making File" ?softerror ?exit
  263.                 tend @ tb: torig tb: tend @ negate cmovel
  264.                                                 \ text to buffer beginning.
  265.                 0.0 shndl @ movepointer
  266.                 torig tend @ negate             \ -- text_length
  267.                 dup 4 - tb: @l 2573 <>           \ append CRLF if not already
  268.                 if      2573 over tb: !L 2+     \ there.
  269.                         2573 over tb: !L 2+
  270.                 then    dup >r
  271.                 r@ 0 128 um/mod nip 1+ currentsize !
  272.                 shndl @ tsegb @ exhwrite r> <> dup
  273.                 " Error while writing, probably out of space."
  274.                 ?softerror ?exit
  275.                 shndl @ hclose " Error Closing File" ?softerror
  276.                 torig tb: tend @ tb: dup negate cmovel> ;
  277.                                                 \ text back to buffer end.
  278.  
  279. : skeyfilter    ( n1 --- n2 ) normfilter
  280.                 filtering @ 0= ?exit
  281. ( escape key )  dup  27 = if drop 13 escflg on exit then
  282. ( Alt-F10 key)  dup 241 = if drop 13 escflg on      then ;
  283.  
  284. \ ' skeyfilter is keyfilter
  285.  
  286. : getafile      ( --- f1 )
  287.                 >in @ span @ 1- >               \ entered filename?
  288.                 if      @> key up @ + @ >r
  289.                         ['] normkey is key
  290.                         getfile                 \ no, get one from windw
  291.                         r> is key
  292.                         if      file>tib        \ good, then to TIB
  293.                         else    span off
  294.                                 #tib off
  295.                                 >in  off
  296.                         then
  297.                 then    >in @ span @ 1- > 0=    \ if tib has name
  298.                 if      bl word
  299.                         shndl @ $>handle true   \ moveit then done
  300.                         loadline off            \ reset to first line
  301.                 else    false                   \ else no good
  302.                 then    ;
  303.  
  304. : get.filename  ( --- f1 )
  305.     begin   0 3 at escflg off filtering on
  306.         creeol
  307.         ." Enter a " >rev ."  NEW " >norm ."  Filename to create and edit."
  308.          creeol
  309.          creeol
  310.          creeol
  311.          creeol
  312.         ." Press " >rev ."  Enter " >norm
  313.         ."  alone to display a list of existing files."
  314.         creeol
  315.         creeol
  316.         ."       " >rev ."  ESC = QUIT " >norm
  317.         0 6 at
  318.         ." ->" query filtering off escflg @
  319.         if      creeol
  320.                 creeol ." Written by Tom Zimmer"
  321.                 creeol 11 ss     ." 292 Falcato Drive"
  322.                 creeol 11 ss     ." Milpitas, California"
  323.                 creeol 22 ss     ." Zip 95035    hm (408) 263-8859"
  324.                 creeol 35 ss                  ." wk (408) 432-4643"
  325.                 creeol
  326.                 shndl @ hopen drop      \ try to leave the file open
  327.                                           \ but don't get upset if it won't
  328.                                             \ open.
  329.                 creeol false true
  330.         else    getafile ?dup
  331.         then    erase.bottom creeol
  332.     until       ;
  333.  
  334. : set.file      ( t1 --- f1 )   \ setup file name in shndl
  335.                 bl word c@
  336.                 if      here shndl @ $>handle true
  337.                 else    get.filename
  338.                 then    ;
  339.  
  340. : get           ( t1 --- f1 )      \ get a file, return true if ok
  341.                 set.file dup
  342.                 if      read.file
  343.                         shndl @ pathset " Can't read path" ?terror
  344.                 then    ;
  345.  
  346. : put           ( --- )         \ save a file
  347.                 write.file ;
  348.  
  349. : linebuf:      ( --- seg a1 )  \ a useful primitive
  350.                 ?cs: linebuf ;
  351.  
  352. : lineinfo      ( --- a1 n1 )   \ info on current line
  353.                 curline #linedata ;
  354.  
  355. : showcur       ( --- )         \ display cursor at proper loc
  356.                 screenchar
  357.                 dup 79 > if 40 mod 40 + then
  358.                 screenline at ;
  359.  
  360. : #lineinfo     ( n1 --- seg a1 n2 )
  361.                 dup curline 1- =
  362.                 if      tb: >lineptr tl:@ toff @ over -
  363.                 else    tb: #linedata
  364.                 then    ;
  365.  
  366. : stripbl's     ( --- )         \ strip off trailing blanks
  367.                 linebuf count -trailing linebuf c! drop ;
  368.  
  369. : restore.name  ( --- )         \ restore backup file extension
  370.                 shndl @ handle>ext 1+ temp.buf 1+ 3 cmove
  371.                 3 temp.buf c! " BAK" ">$ shndl @ $>ext
  372.                 shndl @ hopen 0=
  373.                 if      shndl @ hclose drop
  374.                         temp.buf change.ext
  375.                 then    temp.buf shndl @ $>ext ;
  376.  
  377. : getline       ( --- )         \ get current line to linebuf.
  378.                 linebuf linebuf.len blank
  379.                 lineinfo >r tb:
  380.                 linebuf: 1+ r@ ch/l 2+ min cmovel  ( --- )
  381.                 r@ 2- =: linelen
  382.                 r> linebuf + 1- dup @ crlfval =
  383.                 if      blbl swap !
  384.                 else    drop  2 +!> linelen
  385.                 then    linebuf linelen + dup c@ 9 =
  386.                 if      bl over c! decr> linelen
  387.                 then    drop ch/l linebuf c! lchng off ;
  388.  
  389. : putline       ( --- )
  390.                 lchng @ 0= ?exit        \ only save if changed
  391.                 stripbl's               \ restore linebuf to file
  392.                 linebuf count + crlfval swap !
  393.                 linebuf c@ 2+ linebuf c!
  394.                 linebuf: count >r tsegb @ lineptr dup tl+ tl:@
  395.                 linebuf c@ - dup rot tl:!
  396.                 dup tend ! r> cmovel ;
  397.  
  398. : curline+      ( --- )         \ move down one line in text
  399.                 curline lastline @ = ?exit
  400.                 lineinfo >r tb: toff @ tb: r@ cmovel
  401.                 toff @ lineptr tl:! r> toff +!
  402.                 incr> curline lineptr tl:@ tend ! ;
  403.  
  404. : curline-      ( --- )         \ move up one line in text
  405.                 curline 0= ?exit
  406.                 tsegb @ lineptr dup tl- tl:@ toff @ over - >r
  407.                 swap tl:@ r@ - tb: r@ cmovel
  408.                 r@ negate toff +!
  409.                 lineptr dup tl:@ r> - swap tl- tl:!
  410.                 decr> curline lineptr tl:@ tend ! ;
  411.  
  412. variable rsplit
  413.  
  414. : ?lf's         ( --- )         \ check for file has lf's
  415.                 0       ch/l 2+ torig   mxlln rsplit !
  416.                 do      i tb:   @l crlfval =
  417.                         if      drop -1 leave
  418.                         then
  419.                 loop    ( --- f1 )      \ true if has line feed
  420.                 0=
  421.                 if      creeol ." Splitting lines longer than "
  422.                         64 .  64 rsplit !
  423.                         creeol ." Changing EXT to .TMP" creeol
  424.                         " TMP" ">$ shndl @ $>ext newfl on  beep
  425.                         2 seconds changed on \ make it save !
  426.                 then    ;
  427.  
  428. : stripCtl-Z's  ( --- )
  429.                 toff @ dup dup 128 - swap 1-
  430.                 ?do     i tb: c@l control Z <>
  431.                         if      drop i 1+ leave
  432.                         then
  433.             -1 +loop    dup toff ! 1- tb: c@l 10 -      \ if file doesn't end
  434.                 if      crlfval toff @ tb: !l           \ with CRLF then
  435.                         2 toff +!                       \ add them
  436.                 then    ;
  437.  
  438.                 \ conditional lastline and firstline tests
  439.  
  440. : ?lastline     ( --- f1 ) curline lastline @ >= ;
  441.  
  442. : ?firstline    ( --- f1 ) curline 1 < ;
  443.  
  444. : >lf           ( a1 --- a2 )   \ find the next linefeed in file
  445.                 dup ch/l 10 scan 0=
  446.                 if      drop rsplit @ 1- +
  447.                 else    nip ( over - )
  448.                 then    ( xrmrgn @ over max xrmrgn ! + ) ;
  449.  
  450. : build.linelist ( --- )
  451.                 tsegb @ sseg !                  \ seg search segment
  452.                 tend @  maxlines 1- 0
  453.                 do      incr> curline
  454.                         >lf 1+ dup lineptr tl:!
  455.                         dup 0= ?leave
  456.                 loop    drop ?cs: sseg ! ;      \ Restore the search segment
  457.  
  458. : sinit         ( --- ) \ initialize file, and linelist table
  459.                 changed off
  460.                 ?lf's stripCtl-Z's imode on -1 markline !
  461.                 torig tb: toff @ tb: dup negate swap cmovel>
  462.                 toff @ negate tend ! toff off
  463.                 updated off lookflg off
  464.                 0 =: curline lmrgn off
  465.                 first.textline =: screenline
  466.                              0 =: screenchar   \ xrmrgn off
  467.                 tend @ lineptr tl:!
  468.                 build.linelist
  469.                 curline 1- lastline ! 0 =: curline getline ;
  470.  
  471. : pagechar      ( --- )
  472.                 79 #out ! >rev 31 femit ;
  473.  
  474. code ?page-char ( n1 --- )
  475.                 pop ax
  476.                 sub dx, dx
  477.                 mov bx, # prtlines
  478.                 div bx
  479.                 cmp dx, # 0
  480.              0= if      mov ax, # ' pagechar
  481.                         jmp ax
  482.                 then
  483.                 next    end-code
  484.  
  485. : sltype        ( n1 --- ) \ n1 is data line
  486.                 >norm
  487.                 @> tsegb !> TYPESEG              \ set VTYPE source segment
  488.                 on> nosetcur
  489.                 dup curline 1- =
  490.                 if      >lineptr tl:@ @> toff over -
  491.                 else    #linedata
  492.                 then    2- clipline video-type
  493.                 ?cs: !> TYPESEG                 \ restore VTYPE source segment
  494.                 eeol
  495.                 off> nosetcur ;
  496.  
  497. : <statfunc>    ( --- ) \ show file status to user
  498.                 >attrib1
  499.                 ."   Row="       curline              1+ 5 .l
  500.                 ." Column="      screenchar              4 .l
  501.                 ."  Page#="      curline prtlines /   1+ 4 .l
  502.                 ."  Lines="      lastline           @ 1+ 5 .l
  503.                 ."  Characters=" tend @ negate toff @  + 5 .l
  504.                 >norm 79 #out @ 79 min - 0 max -s '|
  505.                 0 last.textline 1+ at |.
  506.                 shndl @ count dup 16 + 79 swap - 2 /mod swap >r >r
  507.                 r@ 1- >norm -s >attrib1
  508.                 ."  Current file = " over + swap
  509.                 ?do i c@ femit loop
  510.                 ."  " >norm r> r> + ( 1+ ) 1- 0 max -s .|
  511.                 2 last.textline 1+ at >attrib4 ."  HELP=F1 " >norm ;
  512.  
  513. : fullfunc      ( --- ) \ status for when file is full > 64k
  514.                 0 statusline at |' 4 -s >attrib1
  515.                 >boldblnk ." MEM FULL" >norm <statfunc> ;
  516.  
  517. : statfunc      ( --- )
  518.                 0 statusline at |' 4 -s >attrib1
  519.                 imode @
  520.                 if      >attrib4     ."  INSERT "
  521.                 else    >attrib1     ." OVERTYPE"
  522.                 then    >norm <statfunc> ;
  523.  
  524. ' statfunc is showstat
  525.  
  526. lines/screen 1- constant lsl    \ last screen line
  527.  
  528. : ?full         ( --- f1 )      \ is memory full?
  529.                 tend @ negate toff @ + 0 64000. d> ;
  530.  
  531. : ?showfull     ( --- )         \ set status func for memory
  532.                 ?full dup       \ condition
  533.                 if      ['] fullfunc is showstat
  534.                 else    ['] statfunc is showstat
  535.                 then    ;
  536.  
  537. : ?maxlines     ( --- f1 )
  538.                 lastline @ 4 + maxlines > ;
  539.  
  540. : sdisp         ( --- )
  541.                 0 screenline at
  542.                 on> nosetcur
  543.                 linebuf 1+ linelen clipline video-type eeol
  544.                 curline ?page-char
  545.                 off> nosetcur
  546.                 >norm ;
  547.  
  548.  
  549. : scrshow       ( --- )         \ display screen full of file.
  550.                 cursor-off
  551.                 first.textline curline screenline
  552.                 first.textline - -
  553.                 0 max dup [ last.textline 1+ first.textline - ] literal
  554.                 + swap
  555.                 do      i curline =     >norm
  556.                         if      sdisp
  557.                         else    dup !> #line #out off
  558.                                 i lastline @ <=
  559.                                 if      i sltype
  560.                                 else    end-eeol
  561.                                 then    i ?page-char
  562.                         then    1+
  563.                 loop    drop >norm cursor-on ;
  564.  
  565. : <sdln>        ( --- )
  566.                 putline curline+ getline ;
  567.  
  568. : <suln>        ( --- )         \ sequential line down
  569.                 putline curline- getline ;
  570.  
  571. : sdisplay      ( --- )         \ display current screen line.
  572.                 cursor-off sdisp cursor-on ;
  573.  
  574. : ins.linelist  ( --- )         \ add new entry to line pointer
  575.                 lineptr tl: dup tl+ tl:   \ list.
  576.                 maxlines curline - 1- 2* cmovel>
  577.                 lastline incr ;
  578.  
  579. : ?appendline   ( --- )
  580.                 ?lastline
  581.                 if      lineptr tl+ dup tl:@ swap tl+ tl:!
  582.                         lastline incr
  583.                 then    ;
  584.  
  585. : clipdown      ( --- )
  586.                 screenline >r
  587.                 last.textline lastline @ curline - 0 max -
  588.                 screenline max last.textline min
  589.                 curline first.textline + min
  590.                 dup =: screenline r> <>
  591.                 if      scrshow then    ;
  592.  
  593. : sdln          ( --- )         \ sequential line down
  594.                 ?lastline ?exit
  595.                 <sdln> incr> screenline clipdown ;
  596.  
  597. : <shom>        ( --- )         \ home to beginning of file
  598.                 putline
  599.                 begin   ?firstline 0=
  600.                 while   curline-
  601.                 repeat  first.textline =: screenline
  602.                 0 =: screenchar lmrgn off
  603.                 getline ;
  604.  
  605. : shom          ( --- )
  606.                 <shom> scrshow ;
  607.  
  608. : suln         ( --- )         \ sequential line up
  609.                 ?firstline if exit then
  610.                 <suln> decr> screenline screenline >r
  611.                 screenline first.textline - curline min
  612.                 0 max first.textline + dup =: screenline r> <>
  613.                 if      scrshow
  614.                 then    ;
  615.  
  616. : ?cursor       ( --- )
  617.                 imode @
  618.                 if      ins-cursor else norm-cursor then ;
  619.  
  620. : line>ldel.buf ( --- )
  621.                 dseg @
  622.                 if      dseg @ ldel.buf 2dup mxlln +
  623.                         ldel.cnt @ maxdline 1- min mxlln * cmovel>
  624.                         ldel.cnt dup @ 1+ maxdline 1- min swap !
  625.                         linelen linebuf c! ?cs: linebuf dseg @ ldel.buf
  626.                         linelen 1+ mxlln min cmovel
  627.                 then    ;
  628.  
  629. : ldel>linebuf  ( --- )
  630.                 dseg @
  631.                 if      dseg @ ldel.buf 2dup c@l
  632.                         ?cs: linebuf rot 1+ cmovel
  633.                         linebuf c@ =: linelen
  634.                         dseg @ ldel.buf 2dup mxlln + 2swap
  635.                         ldel.cnt @ maxdline min dup 1- ldel.cnt !
  636.                         mxlln * cmovel
  637.                 then    ;
  638.  
  639. : #deletelines  ( n1 --- )
  640.                 0 max ?dup 0= ?exit
  641.                 dup >r tl* tl:@ tend !
  642.                 lineptr tl: dup r@ tl* + tl: 2swap
  643.                 maxlines >lineptr lineptr r@ tl* + - cmovel
  644.                 r> negate lastline +!
  645.                 getline
  646.                 changed on
  647.                 lchng on ;
  648.  
  649. : linedelete    ( --- )
  650.                 lineptr dup tl+ tl:@ tend !
  651.                 maxlines >lineptr over - >r
  652.                 tl: dup tl+ tl: 2swap r> cmovel
  653.                 lastline decr
  654.                 getline
  655.                 changed on
  656.                 lchng on ;
  657.  
  658. : <ldel>        ( --- )         \ delete the current line.
  659.                 ?appendline
  660.                 line>ldel.buf
  661.                 linedelete
  662.                 ?showfull drop ;
  663.  
  664. : ldel          ( --- ) <ldel> scrshow ;
  665.  
  666. : to.line       ( n1 --- )
  667.                 begin   curline over <
  668.                         ?lastline 0= and
  669.                 while   curline+ repeat  drop getline ;
  670.  
  671. : backto.line   ( n1 --- )
  672.                 begin   curline over >
  673.                 while   curline- repeat  drop getline ;
  674.  
  675. : .elapse       ( --- )
  676.                 ." Edit time " time-elapsed b>t
  677.                 ttime 2@ <.time> ;
  678.  
  679. : updt          ( --- )         \ save changes if any to disk.
  680.                 changed @ 0=
  681.                 if      0 statusline at >attrib2 "     No Changes to save"
  682.                         type eeol >norm showcur 5 tenths
  683.                 else    screenchar >r
  684.                         screenline >r curline >r 0 statusline at
  685.                         >attrib2 ."     Saving Changes to " .SHNDL eeol >norm
  686.                         shom
  687.                         ?enoughdisk
  688.                         if      put
  689.                                 changed off updated on
  690.                         else    showstat
  691.                         then
  692.                         r> to.line
  693.                         r> =: screenline r> =: screenchar
  694.                 then    scrshow ?cursor emptykbd fdbuf off ;
  695.  
  696. : squt          ( f1 --- f2 )   \ discard changes and exit
  697.                 dark 0 2 at .elapse
  698.                 loadline off
  699.                 lastldline off
  700.                 updated @ 0= renaming @ 0<> and
  701.                 if     restore.name     then
  702.                 ." Edit Aborted on " .SHNDL eeol drop -1
  703.                 edready off ;
  704.  
  705. : <sesc>        ( f1 --- f2 )   \ save changes and exit
  706.                 curline 0=
  707.                 if      loadline off
  708.                 else    curline 1- #lineinfo + nip loadline !
  709.                         curline lastldline !
  710.                 then
  711.                 shom dark 0 2 at .elapse
  712.                 changed @
  713.                 if      ."  Saving Changes to " .SHNDL
  714.                         ?enoughdisk
  715.                         if      put eeol drop -1 changed off
  716.                         else    scrshow showstat
  717.                         then
  718.                 else    updated @ 0= renaming @ 0<> and
  719.                         if      restore.name
  720.                         then
  721.                         ."  No changes to save in " .SHNDL
  722.                         drop -1 changed off
  723.                 then    ;
  724.  
  725. : sesc          ( f1 --- f2 )   \ save changes and exit
  726.                 ?ctrlkey ?shiftkey and          \ holding down Control & Shift
  727.                 renaming @ 0<> and              \ and RENAMING is not 0
  728.                 if      restore.name            \ then restore backup file
  729.                         renaming off
  730.                         <sesc>                  \ and overwrite it with memory.
  731.  
  732.                 else    ?shiftkey               \ Holding down SHIFT
  733.                         if      squt            \ then quit, and dont save
  734.                         else    <sesc>          \ else go ahead and save
  735.                         then
  736.                 then    ;
  737.  
  738. defer <nlnx>      ' noop is <nlnx>
  739.  
  740.                 \ conditionally add a line
  741. : ?addline      ( -- )
  742.                 ?lastline
  743.                 if      screenchar
  744.                         ch/l =: screenchar
  745.                         <nlnx>
  746.                         =: screenchar
  747.                 then    ;
  748.  
  749. : rchr          ( --- )         \ right a character
  750.                 screenchar 1+ ch/l 1- min dup =: screenchar
  751.                 rmargin @ >=
  752.                 if      0 =: screenchar ?addline
  753.                         sdln scrshow
  754.                 then    screenchar 40 - 40 /mod 0<> swap 0= and
  755.                 if      scrshow then    ;
  756.  
  757. : chrptr        ( --- a1 )      \ cur character line pointer
  758.                 screenchar linebuf 1+ + ;
  759.  
  760.                                 \ goto beginning of curent line
  761. : shoml         ( --- ) 0 =: screenchar lmrgn off scrshow ;
  762.  
  763. : sendl         ( --- )         \ goto end of current line
  764.                 stripbl's linebuf c@ =: linelen
  765.                 ch/l linebuf c!
  766.                 linelen =: screenchar scrshow ;
  767.  
  768. : send          ( --- )         \ goto end of file
  769.                 putline
  770.                 begin   ?lastline 0=
  771.                 while   curline+
  772.                 repeat  last.textline curline 1+ min =: screenline
  773.                 getline sendl ;
  774.  
  775. : ?leftshow     ( --- )         \ reshow screen of screen scrolled
  776.                 screenchar 40 /mod 0<> swap 39 = and
  777.                 if      scrshow
  778.                 then    ;
  779.  
  780. : lchr          ( --- )         \ left a character
  781.                 -1 +!> screenchar screenchar 0<
  782.                 if      0 =: screenchar suln
  783.                         sendl scrshow
  784.                 then    ?leftshow ;
  785.  
  786. : ?showstatus   ( --- ) normbgstuff
  787.                 vstaton @ 0= if exit then
  788.                 statcnt @ 40 >
  789.                 if      statcnt off  vstaton off
  790.                         #out @ #line @ showstat at ?cursor
  791.                 then    statcnt incr ;
  792.  
  793. \ ' ?showstatus is bgstuff
  794.  
  795. : statkey       ( --- c1 )
  796.                 normkey statcnt off ;
  797.  
  798. \ ' statkey is key
  799.  
  800. : pdn           ( --- )         \ go down a page in file
  801.                 ?lastline if exit then
  802.                 putline getline
  803.                 last.textline 1+ first.textline - 2- 0 max 0
  804.                ?do      putline curline+ getline
  805.                         ?lastline
  806.                         if      last.textline =: screenline
  807.                                 leave
  808.                         then
  809.                 loop    clipdown scrshow emptykbd ;
  810.  
  811. : pup           ( --- )         \ go up a page in file
  812.                 ?firstline if exit then
  813.                 putline getline
  814.                 last.textline 1+ first.textline - 2- 0 max 0
  815.                ?do      putline curline- getline
  816.                         ?firstline
  817.                         if      first.textline =: screenline
  818.                                 leave
  819.                         then
  820.                 loop    screenline first.textline curline +
  821.                 min     =: screenline scrshow emptykbd ;
  822.  
  823. : >space        ( --- )         \ move to next space in line
  824.                 linelen dup screenchar over min
  825.                 ?do     linebuf 1+ i + c@ dup bl =
  826.                         swap 127 > or
  827.                         if      drop i leave
  828.                         then
  829.                 loop    =: screenchar   ;
  830.  
  831. : space>        ( --- )         \ move to non blank in line
  832.                 linelen dup screenchar over min
  833.                 ?do     linebuf 1+ i + c@ dup bl <>
  834.                         swap 127 > 0= and
  835.                         if      drop i leave
  836.                         then
  837.                 loop    linelen min =: screenchar ;
  838.  
  839. : <<space>      ( ---  f1 )     \ t1 = true if found space
  840.                 0 dup screenchar
  841.                 ?do     linebuf 1+ i + c@ dup bl =
  842.                         swap 127 > or
  843.                         if      drop i leave
  844.                         then
  845.             -1 +loop    dup =: screenchar ;
  846.  
  847. : <text         ( --- )      \ move to previous text in line.
  848.                 0 dup screenchar
  849.                 ?do     linebuf 1+ i + c@ dup bl <>
  850.                         swap 127 > 0= and
  851.                         if      drop i leave
  852.                         then
  853.             -1 +loop    =: screenchar ;
  854.  
  855. : rwrd          ( --- )
  856.                 screenchar linelen rmargin @ min =
  857.                 ?lastline 0= and
  858.                 if      0 =: screenchar sdln
  859.                         scrshow exit
  860.                 then    >space
  861.                 screenchar linelen >=
  862.                 if      scrshow exit
  863.                 then    space>
  864.                 scrshow ;
  865.  
  866. : lwrd          ( --- )         \ go back to previous word.
  867.                 screenchar 0= ?firstline   0= and
  868.                 if      suln linelen =: screenchar
  869.                         scrshow exit
  870.                 then    screenchar 1- 0 max =: screenchar
  871.                 <text   screenchar 0=
  872.                 if      scrshow exit
  873.                 then    <<space>
  874.                 if      incr> screenchar
  875.                 then    rmargin @ screenchar min =: screenchar
  876.                 scrshow ;
  877.  
  878. : splitline     ( --- )
  879.                 linebuf screenchar + 1+ dup split.buf 1+
  880.                 linelen screenchar - 1+ 0 max dup >r cmove
  881.                 r> split.buf c! ch/l screenchar - blank
  882.                 screenchar =: linelen
  883.                 ?appendline
  884.                 lchng on <sdln>
  885.                 linebuf linebuf.len blank
  886.                 split.buf count linebuf 1+ lmrgn @ + swap cmove
  887.                 split.buf c@ lmrgn @ + dup linebuf c! =: linelen
  888.                 ins.linelist
  889.                 lchng on <suln> ;
  890.  
  891. : <nln>         ( --- ) \ inserts line if in insert mode.
  892.                 ?showfull ?maxlines or
  893.                 if beep exit then
  894.                 imode @
  895.                 if      SplitLine
  896.                 else    ?lastline
  897.                         if      stripbl's
  898.                                 linebuf c@ =: screenchar
  899.                                 SplitLine
  900.                         then
  901.                 then    changed on ;
  902.  
  903. ' <nln> is <nlnx>
  904.  
  905. : nln           ( --- ) \ next line function
  906.                         \ inserts line if in insert mode.
  907.                 <nln>   sdln
  908.                 lmrgn @ dup =: screenchar
  909.                 linelen max =: linelen
  910.                 ch/l linebuf c!
  911.                 scrshow ;
  912.  
  913. : nodisp-nln    ( --- ) \ next line function
  914.                         \ inserts line if in insert mode.
  915.                 <nln>   <sdln>
  916.                 0 =: screenchar
  917.                 ch/l linebuf c! ;
  918.  
  919. : csaveon       csaveflg on ;
  920.  
  921. : csaveoff      csaveflg off ;
  922.  
  923. : csave         ( c1 --- )
  924.                 csaveflg @ 0= if drop exit then \ leave if not saving chars.
  925.                 fdbuf c@ 32 >
  926.                 if      fdbuf count >r dup 1+ swap r> cmove
  927.                         fdbuf c@ 1- 0 max fdbuf c!
  928.                 then    fdbuf count + c!
  929.                         fdbuf c@ 1+ fdbuf c! ;
  930.  
  931. : <fdel>        ( --- )
  932.                 screenchar dup linebuf + 1+ dup c@ csave
  933.                 dup 1+ swap
  934.                 rot ch/l 1+ swap - cmove changed on
  935.                 lchng on ?showfull drop
  936.                 decr> linelen ;
  937.  
  938. : split.lineend ( --- )
  939.                 wrap.buf linebuf.len blank
  940.                 rmargin @ 1- =: screenchar <<space> drop
  941.                 screenchar 1+ lmrgn @ 1+ max  ( was 2+ *** )
  942.                 dup >r =: screenchar
  943.                 linebuf screenchar linelen over - 0 max >r +
  944.                 1+ dup wrap.buf 1+ r@ cmove
  945.                 r@ wrap.buf c!
  946.                 r> blank lchng on
  947.                 putline getline wrapped @ 0=
  948.                 if      wrap.buf c@ wraplen !
  949.                         wrapped on r@ wraploc !
  950.                 then    r>drop ;
  951.  
  952. : prepend.split ( --- )
  953.                 linebuf 1+ rmargin @ bl skip 0=
  954.                 wrap.buf c@ rmargin @ > or
  955.         if      drop linebuf 1+ lmrgn @ +
  956.                 0 =: screenchar <nln> 0 =: screenchar
  957.         else    wrap.buf c@ 1+ >r linebuf 1+ dup r@ +
  958.                 linelen 1+ r@ + ch/l min r@ - cmove>
  959.                 linebuf 1+ r> blank
  960.         then    ch/l linebuf c! dup linebuf 1+ -
  961.                 rmargin @ 2 - min lmrgn ! ( was 6 - *** )
  962.                 >r wrap.buf count r@ swap cmove
  963.                 wrap.buf c@ 1+ +!> linelen
  964.                 wrap.buf c@ r> linebuf 1+ - + =: screenchar
  965.                 lchng on putline getline ;
  966.  
  967. defer showst    ' showstat is showst
  968.  
  969. : ?lmargin      ( --- )
  970.                 screenchar 0=
  971.                 if      lmrgn @ =: screenchar then ;
  972.  
  973. : ?right        ( --- )
  974.                 wrapped @
  975.                 if      screenchar wraploc @ <
  976.                         if      rchr ?lmargin
  977.                         else    screenchar wraploc @ -
  978.                                 lmrgn @ + 1+ =: screenchar
  979.                                 sdln
  980.                         then    scrshow
  981.                 else    rchr    ?lmargin
  982.                 then    ;
  983.  
  984. : del<>bl's     ( --- )         \ delete non blanks
  985.                 begin   chrptr c@ bl <>
  986.                 while   <fdel>
  987.                 repeat  ;
  988.  
  989. : delbl's       ( --- )         \ delete blanks
  990.                 rmargin @ screenchar
  991.                 ?do      chrptr c@ bl <> ?leave <fdel>
  992.                 loop    ;
  993.  
  994. : AppendLine    ( --- )         \ append this line to previous.
  995.                 ?firstline if beep exit then imode @
  996.         if      stripbl's split.buf linebuf.len blank
  997.                 linebuf split.buf over c@ dup >r 1+ cmove
  998.                 curline 1- #lineinfo nip nip r> + ch/l 1- >
  999.                 if      beep getline 0 =: screenchar
  1000.                 else    ?lastline 0= if ldel then suln stripbl's
  1001.                         split.buf count linebuf count 1+
  1002.                         dup >r + swap cmove  lchng on split.buf c@ r@ +
  1003.                         ch/l 10 - min dup 10 + linebuf c! =: linelen
  1004.                         r> rmargin @ 1- min =: screenchar putline
  1005.                         screenchar linelen 1- min =: screenchar
  1006.                 then
  1007.         else    suln stripbl's linebuf c@ =: screenchar
  1008.         then    getline sdisplay ;
  1009.  
  1010. : bdel          ( --- )         \ back delete
  1011.                 screenchar 0=
  1012.                 if      AppendLine scrshow
  1013.                 else    imode @
  1014.                         if      screenchar dup linebuf + 1+ dup 1-
  1015.                                 rot ch/l 1+ swap - cmove
  1016.                                 decr> screenchar
  1017.                                 linelen 1- screenchar max linelen min
  1018.                                 =: linelen
  1019.                         else    decr> screenchar
  1020.                                 bl chrptr c! lchng on putline getline
  1021.                         then    sdisplay screenchar lmrgn @ min lmrgn !
  1022.                 then    lchng on changed on
  1023.                 ?showfull drop ?leftshow ;
  1024.  
  1025. : nodisp-schr   ( c1 --- )    \ insert sequential char in line.
  1026.                 ?showfull ?exit
  1027.                 screenchar linelen max =: linelen
  1028.                 screenchar linebuf 1+ + dup 1+
  1029.                 linelen screenchar - 0 max cmove> incr> linelen
  1030.                 dup screenchar linebuf 1+ + c!  bl <>
  1031.                 if      linelen screenchar 1+ max =: linelen
  1032.                 then    changed on lchng on
  1033.                 screenchar 1+ ch/l 1- min =: screenchar ;
  1034.  
  1035. : schr          ( c1 --- )    \ insert sequential char in line.
  1036.                 ?showfull ?exit
  1037.                 screenchar linelen max =: linelen
  1038.                 imode @
  1039.         if      screenchar linebuf 1+ + dup 1+
  1040.                 linelen screenchar - 0 max cmove> incr> linelen
  1041.         then    dup screenchar linebuf 1+ + c!  bl <>
  1042.                 if      linelen screenchar 1+ max =: linelen
  1043.                 then    sdisplay changed on lchng on
  1044.                 ( ?wrap  ) ?right  ;
  1045.  
  1046. : wudel         ( --- )
  1047.                 imode dup @ >r on
  1048.                 fdbuf count bounds
  1049.                 ?do     fdbuf 1+ c@ >r                  \ get char
  1050.                         fdbuf 2+ fdbuf 1+               \ source destination
  1051.                         fdbuf c@ 1- 0 max cmove         \ clip char out
  1052.                         fdbuf c@ 1- 0 max fdbuf c!      \ reduce count
  1053.                         r> ?dup 0= ?leave               \ leave if null
  1054.                         schr                            \ insert it
  1055.                 loop    r> imode ! ;
  1056.  
  1057. : #linelook     ( n1 --- f1 )   \ look through line n1
  1058.                 >r slook.buf count r> #lineinfo rot drop
  1059.                 screenchar - 0 max swap screenchar + swap
  1060.                 search swap over
  1061.                 if      +!> screenchar
  1062.                 else    drop
  1063.                 then    ;
  1064.  
  1065. variable inputline
  1066. variable looked
  1067.  
  1068. : input$        ( a1 n1 -- a2 ) escflg off filtering on
  1069.                 1 inputline @ at >attrib1 type
  1070.                 #out @ eeol      >norm
  1071.                 inputline @ at
  1072.                 temp2.buf 1+ dup 66 blank 64 expect
  1073.                 temp2.buf span @ over c! filtering off ;
  1074.  
  1075. : look.till     ( --- f1 )
  1076. \                time-reset
  1077.                 0 =: screenchar
  1078.                 putline
  1079.                 tsegb @ sseg !
  1080.                 0               \ Leave false bool in case we don't find it.
  1081.                 lastline @ 1+ curline 1+ over min
  1082.                 ?do     slook.buf count i #linedata search
  1083.                         if      =: screenchar
  1084. \ 60 24 at <.elapsed> 5 tenths
  1085.                                 i to.line 0=    \ change false bool to true
  1086.                                 leave           \ and leave
  1087.                         else    drop
  1088.                         then    key? ?leave
  1089.                         i 63 and 0=
  1090.                         if      cursor-off 19 statusline at
  1091.                                 I 1+ 4 >attrib1 .l >norm
  1092.                         then
  1093.                 loop    ?cs: sseg !
  1094.                 getline emptykbd
  1095. \ 60 24 at <.elapsed> 5 tenths
  1096.                 ?cursor ;
  1097.  
  1098. : look.back     ( --- f1 )
  1099.                 0 =: screenchar
  1100.                 putline
  1101.                 tsegb @ sseg !
  1102.                 0               \ Leave false bool in case we don't find it.
  1103.                 0 curline 1- 0 max
  1104.                 ?do     i #linelook
  1105.                         if      i backto.line 0=  \ change false bool to true
  1106.                                 leave             \ and leave
  1107.                         then    key? ?leave
  1108.                         i 63 and 0=
  1109.                         if      cursor-off 19 statusline at
  1110.                                 I 1+ 4 >attrib1 .l >norm
  1111.                         then
  1112.             -1 +loop    ?cs: sseg !
  1113.                 getline emptykbd ?cursor ;
  1114.  
  1115. : <slooker>     ( --- ) ?lastline if exit then
  1116.                 looked off slook.buf c@ 0=
  1117.                 if      rwrd    exit    \ just step to next word
  1118.                 then    putline getline
  1119.                         tsegb @ sseg !
  1120.                         curline >r r@ #linelook 0=
  1121.                         ?cs: sseg !
  1122.                 if      look.till dup lookflg ! 0=
  1123.                         if      beep  r@ backto.line
  1124.                         else    looked on then
  1125.                 else    looked on
  1126.                 then    r>drop
  1127.                 screenline 10 <
  1128.                 if      screenline 1+ curline first.textline +
  1129.                         min =: screenline
  1130.                 then    ;
  1131.  
  1132. : slooker       ( --- ) ?lastline if exit then
  1133.                 caps @ >r ?shiftkey
  1134.                 if      caps off else caps on then
  1135.                 <slooker> r> caps ! ;
  1136.  
  1137. : slookbk       ( --- )
  1138.                 caps @ >r looked off caps on
  1139.                 curline >r look.back dup lookflg ! 0=
  1140.                 if      beep  r@ to.line
  1141.                 else    looked on
  1142.                 then
  1143.                 r>drop r> caps ! ;
  1144.  
  1145. : sloob         ( --- ) \ search again backwards
  1146.                 slookbk scrshow clipdown ;
  1147.  
  1148. : slooa         ( --- ) \ search again forward
  1149.                 incr> screenchar slooker scrshow sdisplay ;
  1150.  
  1151. : sloon         ( --- )
  1152.                 first.textline inputline !
  1153.                 " Text to look for ->"  input$  escflg @
  1154.                 if      drop scrshow exit then dup c@
  1155.                 if      slook.buf over c@ 1+ 30 min cmove
  1156.                         slook.buf dup c@ 30 min swap c!
  1157.                 else    drop then
  1158.                 1 first.textline at >attrib1 ." Looking for .... ->"
  1159.                 #out @ eeol first.textline at
  1160.                 slook.buf count type >norm slooa ;
  1161.  
  1162. create rep.buf  128 allot       rep.buf 128 erase
  1163.  
  1164. variable repset
  1165.  
  1166. : <srepa>       ( --- )
  1167.                 looked @ 0= repset @ 0= or if beep exit then
  1168.                 imode dup @ >r on
  1169.                 slook.buf c@ 0
  1170.                 ?do     <fdel>
  1171.                         lchng on changed on putline getline
  1172.                 loop
  1173.                 rep.buf count bounds
  1174.                 ?do     i c@ schr
  1175.                 loop    looked off
  1176.                 r> imode ! scrshow ;
  1177.  
  1178. : srepa         ( --- ) <srepa> slooa   ;
  1179.  
  1180. : srepn         ( --- )
  1181.                 repset off
  1182.                 looked @ 0= if beep exit then
  1183.                 first.textline inputline !
  1184.                 " Replace with ->"  input$  escflg @
  1185.                 if      drop scrshow exit then dup c@
  1186.                 if      rep.buf over c@ 1+ 30 min cmove
  1187.                         rep.buf dup c@ 30 min swap c!
  1188.                 else    drop
  1189.                 then    repset on srepa ;
  1190.  
  1191. : repall        ( --- )
  1192.                 looked @ if <srepa> then
  1193.                 begin   slooa  looked @
  1194.                 while   <srepa>  repeat ;
  1195.  
  1196. : already_exists?       ( --- f1 )      \ does filename in SHNDL+ exist?
  1197.                 shndl+ hopen 0=         \ if so, then prompt for overwrite.
  1198.                 if      shndl+ hclose drop
  1199.                         0 statusline 2dup at eeol
  1200.                         at >rev space shndl+ count type space
  1201.                         ."  ALREADY EXISTS, overwrite it? Y/N [N]-> "
  1202.                         space
  1203.                         key dup emit space bl or ascii y <> dup
  1204.                         if      ."  Aborting..." 5 tenths >norm scrshow
  1205.                         then    >norm
  1206.                 else    false
  1207.                 then    ;
  1208.  
  1209. : wr->fl        ( --- )
  1210.                 first.textline inputline !
  1211.                 " Write file in memory to Drive:\Path\Filename ->"  input$
  1212.                 dup c@ escflg @ 0= and
  1213.                 if
  1214.                         restore.name
  1215.                         dup shndl+ $>handle
  1216.                         shndl+ pathset drop
  1217.                         already_exists?                 \ overwrite existing?
  1218.                         if      drop exit               \ if not then exit
  1219.                         then
  1220.                         shndl @ $>handle
  1221.                         shndl @ pathset drop
  1222.                         screenchar >r   newfl on  changed on
  1223.                         screenline >r curline >r
  1224.                         shom
  1225.                         0 statusline 2dup at eeol
  1226.                         at ." Saving to File..."
  1227.                         ?enoughdisk
  1228.                         if      put
  1229.                                 changed off updated on
  1230.                                 ." .DONE " 5 tenths
  1231.                         else    showstat
  1232.                         then
  1233.                         begin   curline r@ <>
  1234.                         while   curline+
  1235.                         repeat r>drop r> =: screenline
  1236.                         r> =: screenchar
  1237.                         getline
  1238.                 else    drop
  1239.                 then    scrshow ;
  1240.  
  1241. : <joinln>      ( --- )
  1242.                 screenchar >r
  1243.                 sdln 0 =: screenchar bdel
  1244.                 r> =: screenchar ;
  1245.  
  1246. : joinln        ( --- )
  1247.                 imode dup @ >r on
  1248.                 <joinln> r> imode ! ;
  1249.  
  1250. : itgl          ( --- )         \ insert mode toggle
  1251.                 imode @ 0= imode ! ?cursor ;
  1252.  
  1253. : fdel          ( --- )         \ forward delete
  1254.                 screenchar linelen >=
  1255.                 if      bl schr
  1256.                         <joinln> delbl's
  1257.                 else    csaveon <fdel> csaveoff
  1258.                 then
  1259.                 lchng on changed on putline getline
  1260.                 ?showfull drop sdisplay ;
  1261.  
  1262. : wdel          ( --- )
  1263.                 screenchar linelen >=
  1264.                 if      bl schr
  1265.                         <joinln>                \ unwrap line
  1266.                         chrptr c@ bl =
  1267.                         if      delbl's
  1268.                         then
  1269.                 else    chrptr c@ bl <>
  1270.                         if      csaveon
  1271.                                 del<>bl's       \ delete non blank
  1272.                                 <fdel>          \ delete one blank
  1273.                                 0 csave         \ Append null delimiter
  1274.                                 csaveoff
  1275.                                 delbl's         \ and delete blanks
  1276.                         else    csaveoff
  1277.                                 delbl's
  1278.                         then                    \ for possible undelete
  1279.                 then
  1280.                 lchng on changed on putline getline
  1281.                 ?showfull drop sdisplay ( scrshow ) ;
  1282.  
  1283. : smrk          ( --- )         \ mark line for get
  1284.                 curline markline ! screenchar markchar !
  1285.                 0 statusline at ." --- Mark is Set ---" eeol
  1286.                 5 tenths ;
  1287.  
  1288. : sbtab         ( --- )         \ tab left on screen
  1289.                 lchr screenchar tabsize @ mod 0 ?do lchr loop ;
  1290.  
  1291. : dnln         ( --- ) sdln sdisplay emptykbd ;
  1292.  
  1293. : upln          ( --- ) suln sdisplay emptykbd ;
  1294.  
  1295. : tscrn         ( --- )
  1296.                 begin   ?firstline 0=
  1297.                         screenline first.textline <> and
  1298.                 while   upln
  1299.                 repeat  ;
  1300.  
  1301. : bscrn         ( --- )
  1302.                 begin   ?lastline 0=
  1303.                         screenline last.textline < and
  1304.                 while   dnln
  1305.                 repeat  ;
  1306.  
  1307. : scldn        ( --- )  screenline last.textline <>
  1308.                 if      decr> screenline
  1309.                         sdln scrshow
  1310.                 else    sdln
  1311.                 then    emptykbd ;
  1312.  
  1313. : sclup         ( --- ) screenline first.textline <>
  1314.                 if      incr> screenline
  1315.                         suln scrshow
  1316.                 else    suln
  1317.                 then    emptykbd ;
  1318.  
  1319. : stab          ( --- )         \ tab right on screen
  1320.                 tabsize @ screenchar tabsize @ mod - imode   @
  1321.                 if      0
  1322.                        ?do      bl schr ?full
  1323.                                 screenchar lmrgn @ = or ?leave
  1324.                         loop    changed on
  1325.                 else    +!> screenchar
  1326.                 then    screenchar rmargin @ 1- >=
  1327.                 if      0 =: screenchar sdln
  1328.                 then    linebuf 1+ screenchar bl skip nip 0=
  1329.                 if      screenchar rmargin @ 6 - min lmrgn !
  1330.                 then    scrshow ;
  1331.  
  1332.  
  1333. : e.##          ( N1 --- )      \ Print two low digits of n1.
  1334.                 0 <# # # #> bounds
  1335.                 ?do     i c@ schr ?full ?leave
  1336.                 loop    ;
  1337.  
  1338. : e./           ( --- ) ascii / schr ;
  1339.  
  1340. : e.:           ( --- ) ascii : schr ;
  1341.  
  1342. : paste_datetime ( --- )
  1343.                 base @ >r decimal
  1344.                 imode dup @ >r on
  1345.                 bl schr
  1346.                 getdate 0 256 um/mod e.## e./ e.## e./ 1900 - e.## bl schr
  1347.                 gettime drop 0 256 um/mod e.## e.: e.## bl schr
  1348.                 r> imode !
  1349.                 r> base ! ;
  1350.  
  1351.  
  1352. : tabxp         ( --- )         \ tab expansion word
  1353.                 9 slook.buf 1+ c! 1 slook.buf c!
  1354. \                xrmrgn off
  1355.                 mxlln rmargin !   caps @ >r caps off
  1356.                 shom
  1357.                 begin   incr> screenchar <slooker>
  1358.                         looked @
  1359.                 while   fdel   stab lchr
  1360. \                        xrmrgn  @ linelen max xrmrgn !
  1361.                 repeat  shom
  1362.                 r> caps !
  1363.                 ( xrmrgn @ 2+ mxlln min 80 max rmargin ! ) ;
  1364.  
  1365. : l>lcase       ( --- )         \ convert the current line to lower case
  1366.                 linebuf 1+ linelen bounds
  1367.                 ?do     i c@ ascii A ascii Z between
  1368.                         if      i c@ bl or i c!
  1369.                         then
  1370.                 loop    lchng on changed on
  1371.                 putline getline ;
  1372.  
  1373. : l>ucase       ( --- )         \ convert the current line to lower case
  1374.                 linebuf 1+ linelen bounds
  1375.                 ?do     i c@ ascii a ascii z between
  1376.                         if      i c@ 95 and i c!
  1377.                         then
  1378.                 loop    lchng on changed on
  1379.                 putline getline ;
  1380.  
  1381. : Alt-O         ( --- )         \ Alt-O options
  1382.                 0 statusline at >rev
  1383. ."  Alt-O  (X-exp TABS, L-lowcase, U-UPCASE, P-Paste_Date/Time) press a key"
  1384.                 eeol >norm
  1385.                 >rev sdisplay >norm
  1386.                 cursor-off key bl or >r
  1387.                 ascii x r@ = if tabxp           then
  1388.                 ascii p r@ = if paste_datetime  then
  1389.                 ascii l r@ = if l>lcase         then
  1390.                 ascii u r> = if l>ucase         then
  1391.                 sdisplay showstat cursor-on ;
  1392.  
  1393. : lundel        ( --- )         \ undo line deletes
  1394.                 ldel.cnt @ 0= if beep exit then
  1395.                 imode dup @ >r on
  1396.                 0 =: screenchar nln suln ldel>linebuf
  1397.                 changed on lchng on putline getline
  1398.                 r> imode ! scrshow ;
  1399.  
  1400. : sgetl         ( --- )
  1401.                 markline @ lastline @ 2- > if beep exit then
  1402.                 markline @ -1 =
  1403.                 ?showfull or ?maxlines or if beep exit  then
  1404.                 imode @ >r imode on     changed on
  1405.                 0 =: screenchar nln suln r> imode !
  1406.                 markline @ curline >= if markline incr then
  1407.                 linebuf linebuf.len blank
  1408.                 markline @ #lineinfo 2- >r ?cs: linebuf 1+
  1409.                 r> ch/l 2+ min cmovel ch/l linebuf c!
  1410.                 lchng on putline getline sdln
  1411.                 markline incr scrshow ;
  1412.  
  1413. : spltln        ( --- )
  1414.                 imode dup @ >r on
  1415.                 screenchar >r
  1416.                 nln suln r> =: screenchar
  1417.                 r> imode ! scrshow ;
  1418.  
  1419. : showscreen    ( --- )
  1420.                 showstat scrshow ?cursor ;
  1421.  
  1422.                 \ allow entry of any keyboard character
  1423. : ^cc           ( --- )
  1424.                 0 0 at >attrib2
  1425.                 ."   Enter a key to insert" eeol >norm
  1426.                 showcur key schr ;
  1427.  
  1428. : lmset         ( --- )
  1429.                 screenchar lmrgn !
  1430.                 0 0 at >attrib2
  1431.                 ."   Left Margin set to column " screenchar . eeol >norm
  1432.                 3 tenths showcur ;
  1433.  
  1434. : tabset        ( --- )
  1435.                 screenchar 1 max dup tabsize ! etabsize !
  1436.                 0 0 2dup at >attrib2 eeol at
  1437.                 ."   Tabs set column increment "
  1438.                 screenchar 1 max . >norm
  1439.                 3 tenths showcur ;
  1440.  
  1441. : notavail      ( --- )
  1442.              0 statusline at cursor-off >attrib2
  1443.              ." You MUST Load the expanded function set for that operation."
  1444.              eeol >norm beep 2 seconds cursor-on ;
  1445.  
  1446. defer shelp     ' notavail is shelp
  1447. defer exportx   ' notavail is exportx
  1448. defer excutx    ' notavail is excutx
  1449. defer importx   ' notavail is importx
  1450. defer pmenux    ' notavail is pmenux
  1451. defer kerr      ' beep is kerr
  1452.  
  1453.                 \ control key functiontable
  1454. : s^tbl         ( n1 --- )
  1455.                 exec:
  1456. \ @     A       B       C       D       E       F       G
  1457. kerr    lwrd    kerr    pdn     rchr    upln    rwrd    fdel
  1458. \ H     I       J       K       L       M       N       O
  1459. bdel    stab    kerr    kerr    lmset   nln     spltln  kerr
  1460. \ P     Q       R       S       T       U       V       W
  1461. kerr    kerr    pup     lchr    wdel    updt    itgl    sclup
  1462. \ X     Y       Z       ESC                             F1
  1463. dnln    ldel    scldn   sesc    kerr    kerr    shoml   shelp ;
  1464.  
  1465.  
  1466.                 \ function key table
  1467. : sfuntbl       ( n1 --- )
  1468.                 exec:
  1469. \ A-9   A-0     A -     A =     CPGUP   133     134     135
  1470. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  1471. \ 136   137     138     139     140     141     142     BACKSPACE
  1472. kerr    kerr    kerr    kerr    kerr    kerr    kerr    sbtab
  1473. \ A-Q   A-W     A-E     A-R     A-T     A-Y     A-U     A-I
  1474. kerr    wr->fl  kerr    kerr    tabset  lundel  wudel   kerr
  1475. \ A-O   A-P     154     155     156     157     A-A     A-S
  1476. Alt-O   pmenux  kerr    kerr    kerr    kerr    kerr    kerr
  1477. \ A-D   A-F     A-G     A-H     A-J     A-K     A-L     167
  1478. kerr    kerr    kerr    kerr    kerr    kerr    lmset   kerr
  1479. \ 168   169     170     171     A-Z     A-X     A-C     A-V
  1480. kerr    kerr    kerr    kerr    kerr    excutx  exportx importx
  1481. \ A-B   A-N     A-M     179     180     181     182     183
  1482. kerr    joinln  kerr    kerr    kerr    kerr    kerr    kerr
  1483. \ 184   185     186     F1      F2      F3      F4      F5
  1484. kerr    kerr    kerr    shelp   tscrn   smrk    bscrn   sgetl
  1485. \ F6    F7      F8      F9      F10     197     198     199
  1486. sloon   kerr    srepn   kerr    ^cc     kerr    kerr    kerr
  1487. \ 200   201     202     203     204     205     206     END
  1488. kerr    kerr    kerr    kerr    kerr    kerr    kerr    sendl
  1489. \ 208   209     210     211     SF1     SF2     SF3     SF4
  1490. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  1491. \ SF5   SF6     SF7     SF8     SF9     SF10    CF1     CF2
  1492. kerr    sloob   kerr    repall  kerr    kerr    kerr    kerr
  1493. \ CF3   CF4     CF5     CF6     CF7     CF8     CF9     CF10
  1494. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  1495. \ AF1   AF2     AF3     AF4     AF5     AF6     AF7     AF8
  1496. kerr    kerr    kerr    kerr    kerr    slooa   kerr    srepa
  1497. \ AF9   AF10    242     CLEFT   CRIGHT  CEND    CPGDN   CHOME
  1498. kerr    squt    kerr    lwrd    rwrd    send    kerr    shom
  1499. \ A-1   A-2     A-3     A-4     A-5     A-6     A-7     A-8
  1500. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr ;
  1501.  
  1502. : ?controls     ( c1 --- c1 )   \ handle control characters
  1503.                 dup 32 <
  1504.                 if      0 swap s^tbl
  1505.                 then    ;
  1506.  
  1507. : ?functions    ( c1 --- c2 )   \ handle function characters
  1508.                 dup 127 >       \ they have values >127
  1509.                 if      128 - 0 swap sfuntbl
  1510.                 then    ;
  1511.  
  1512. : ?del          ( c1 --- )      \ char is delete key
  1513.                 dup 127 = if drop fdel 0 then    ;
  1514.  
  1515. : ?schr         ( c1 --- )      \ insert character if not a func
  1516.                 dup 0> if schr 0 then    ;
  1517.  
  1518. : doachar       ( c1 --- f1 )
  1519.                 ?controls ?functions ?del ?schr ;
  1520.  
  1521. ' doachar is doacharx
  1522.  
  1523. variable scrline
  1524.  
  1525. : check.shndl   ( --- f1 )     \ verify shndl is in the hndls array
  1526.                                 \ returns f1, true if we are out of handles
  1527.                 shndl @ hndls u>=
  1528.                 shndl @ hndls maxnest + b/hcb - u< and 0= dup
  1529.                                 \ is shndl within the hndls array?
  1530.                                   \ and not stacked up to last handle.
  1531.                 if       cr ." Sorry, too many files open !"
  1532.                 then    ;
  1533.  
  1534. : find.line     ( --- )         \ Assumes we are starting on first line.
  1535.                 loadline @ 1000 u>
  1536.                 if      ." One moment..."
  1537.                 then
  1538.                 byte|line @     \ Are we going to a byte offset or a line#?
  1539.                 if      loadline @ 0 u>
  1540.                         if      0 lastline @ 0 over min
  1541.                                 ?do     i #linedata nip + dup loadline @  u>=
  1542.                                         if      i 1+ to.line leave
  1543.                                         then
  1544.                                 loop    drop
  1545.                         else    0 to.line
  1546.                         then
  1547.                 else    loadline @ 1- 0 max maxlines min to.line
  1548.                         byte|line on    \ reset to byte offset
  1549.                 then    ;
  1550.  
  1551. : deferset      ( --- )         \ save current deferred words, and reset them
  1552.                 @> keyfilter    is normfilter  ['] skeyfilter  is keyfilter
  1553.                 @> key up @ + @ is normkey     ['] statkey     is key
  1554.                 @> bgstuff      is normbgstuff ['] ?showstatus is bgstuff ;
  1555.  
  1556. : deferreset    ( --- )         \ restore the deferred words old function.
  1557.                 @> normbgstuff is bgstuff
  1558.                 @> normkey     is key
  1559.                 @> normfilter  is keyfilter ;
  1560.  
  1561. : <reedit>      ( --- )         \ reenter edit of file
  1562.                 restore_vectors
  1563.                 ?diskfull drop
  1564.                 time-reset
  1565.                 savestate
  1566.                 updated off
  1567.                 etabsize @ tabsize !
  1568.                 2 lmargin !
  1569.                 132 rmargin !
  1570.                 edready @ 0= abort" No file to re-edit."
  1571.                 dark ?showfull drop ?change.bak
  1572.                 find.line
  1573.                 scrline @ curline 1+ min =: screenline
  1574.                 showscreen
  1575.                 begin   vstaton on showcur key doachar
  1576.                 until
  1577.                 restorestate
  1578.                 set_vectors ;
  1579.  
  1580. : reedit        ( --- )
  1581.                 check.shndl 0=
  1582.                 if      deferset <reedit> deferreset
  1583.                 then    ;
  1584.  
  1585. : <sed>         ( t1 --- )
  1586.                 deferset
  1587.                 dark
  1588.                 begin   close 0 1 at 28 ss
  1589.                         >attrib1 ." Tom's Sequential Editor" >norm
  1590.                         cr 0 3 at get     ( --- f1 )
  1591.                 while   sinit
  1592.                         ['] statfunc is showstat
  1593.                         edready on
  1594.                         <reedit>
  1595.                 repeat  deferreset ;
  1596.  
  1597. : esed          ( t1 --- )      \ entry point for sequential file editor.
  1598.                 check.shndl 0=
  1599.                 if      0 loadline !
  1600.                         1 scrline  ! <sed>
  1601.                 then    ;
  1602.  
  1603. only forth definitions
  1604.  
  1605.